home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / halcn305.zip / GSV_FLDS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-29  |  3KB  |  146 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision Forms Demo                      }
  5. {   Copyright (c) 1990 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit GSV_Flds;
  10.  
  11. {$F+,O+,X+,S-,D+}
  12.  
  13. interface
  14.  
  15. uses Objects, Drivers, Dialogs,
  16.      GSOB_Str;
  17.  
  18. type
  19.  
  20.   PdBInputLine = ^TdBInputLine;
  21.   TdBInputLine = object(TInputLine)
  22.     IsActive    : boolean;
  23.     PrevData    : PString;
  24.     FldLabel    : PLabel;
  25.     constructor Init(var Bounds: TRect; AMaxLen: Integer);
  26.     destructor  Done; virtual;
  27.     function    Changed : boolean; virtual;
  28.     function    DataSize : word; virtual;
  29.     procedure   GetData(var Rec); virtual;
  30.     procedure   SetData(var Rec); virtual;
  31.     procedure   HandleEvent(var Event: TEvent); virtual;
  32.     function    Valid(Command: Word): Boolean; virtual;
  33.   end;
  34.  
  35.   PdBNumInputLine = ^TdBNumInputLine;
  36.   TdBNumInputLine = object(TdBInputLine)
  37.     procedure   SetData(var Rec); virtual;
  38.     function    Valid(Command: Word): Boolean; virtual;
  39.   end;
  40.  
  41. procedure RegisterFields;
  42.  
  43. const
  44.   RdBInputLine: TStreamRec = (
  45.      ObjType: 10061;
  46.      VmtLink: Ofs(TypeOf(TdBInputLine)^);
  47.      Load:    @TdBInputLine.Load;
  48.      Store:   @TdBInputLine.Store
  49.   );
  50.  
  51. implementation
  52.  
  53. uses Views, MsgBox;
  54.  
  55.  
  56. procedure RegisterFields;
  57. begin
  58.   RegisterType(RdBInputLine);
  59. end;
  60.  
  61.  
  62. { TdBInputLine }
  63.  
  64. constructor TdBInputLine.Init(var Bounds: TRect; AMaxLen: Integer);
  65. begin
  66.   TInputLine.Init(Bounds, AMaxLen);
  67.   PrevData := nil;
  68.   IsActive := false;
  69.   FldLabel := nil;
  70. end;
  71.  
  72. destructor TdBInputLine.Done;
  73. begin
  74.   if PrevData <> nil then DisposeStr(PrevData);
  75.   TInputLine.Done;
  76. end;
  77.  
  78. function TdBInputLine.Changed: Boolean;
  79. begin
  80.    if PrevData <> nil then Changed := Data^ <> PrevData^
  81.       else Changed := Data^[0] <> #0;
  82. end;
  83.  
  84. function TdBInputLine.DataSize : word;
  85. begin
  86.    DataSize := MaxLen;
  87. end;
  88.  
  89. procedure TdBInputLine.GetData(var Rec);
  90. begin
  91.   string(Rec) := data^;
  92. end;
  93.  
  94. procedure TdBInputLine.SetData(var Rec);
  95. begin
  96.   data^ := string(Rec);
  97.   if PrevData <> nil then DisposeStr(PrevData);
  98.   PrevData := NewStr(data^);
  99. end;
  100.  
  101. procedure TdBInputLine.HandleEvent(var Event: TEvent);
  102. begin
  103.   TInputLine.HandleEvent(Event);
  104. end;
  105.  
  106. function TdBInputLine.Valid(Command: Word): Boolean;
  107. begin
  108.   Valid := TInputLine.Valid(Command)
  109. end;
  110.  
  111. procedure TdBNumInputLine.SetData(var Rec);
  112. var
  113.    s : string[64];
  114. begin
  115.   fillchar(s,sizeof(s),' ');
  116.   s[0] := chr(MaxLen-length(string(rec)));
  117.   data^ := s + string(Rec);
  118.   if PrevData <> nil then DisposeStr(PrevData);
  119.   PrevData := NewStr(data^);
  120. end;
  121.  
  122. function TdBNumInputLine.Valid(Command: Word): Boolean;
  123. var
  124.   Code: Integer;
  125.   Value: Real;
  126.   Ok: Boolean;
  127. begin
  128.   Ok := True;
  129.   if (Command <> cmCancel) and (Command <> cmValid) then
  130.   begin
  131.      val(data^,Value,Code);
  132.      if Code <> 0 then
  133.      begin
  134.         MessageBox('Numeric value is required in this field',nil,
  135.                     mfError + mfOkButton);
  136.         SelectAll(True);
  137.         Ok := False;
  138.      end;
  139.   end;
  140.   if Ok then Valid := TdBInputLine.Valid(Command)
  141.   else Valid := False;
  142. end;
  143.  
  144.  
  145. end.
  146.